VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ApiHotkey"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' ##MODULE_DESCRIPTION This class provides properties and methods for installing system wide _
hotkeys.

' ##MODULE_DESCRIPTION A system wide hotkey is a special key combination that triggers an _
event when pressed regardless of which application has the focus when the hotkey is pressed. _
For example, pressing the Windows key + E will launch an instance of the windows explorer and _
pressing Windows Key + M minimises all the open windows on a system.

' ##MODULE_DESCRIPTION Using this class allows you to create your own global hotkeys for your _
applications.

Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long

Public Enum enHotkeyModifiers
    MOD_ALT = &H1
    MOD_CONTROL = &H2
    MOD_SHIFT = &H4
    MOD_WIN = &H8
End Enum

Private mModifier As Long
Private mvKey As Long
Private mHWND As Long

Private mhAtom As Long

Private Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer
Private Declare Function GlobalGetAtomName Lib "kernel32" Alias "GlobalGetAtomNameA" (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long) As Long


Public Property Let AltKey(ByVal NewValue As Boolean)

If NewValue Then
    mModifier = mModifier Or MOD_ALT
Else
    mModifier = mModifier Xor MOD_ALT
End If

End Property

Public Property Get AltKey() As Boolean

    AltKey = (mModifier And MOD_ALT)
    
End Property


Public Property Let ControlKey(ByVal NewValue As Boolean)

If NewValue Then
    mModifier = mModifier Or MOD_CONTROL
Else
    mModifier = mModifier Xor MOD_CONTROL
End If

End Property


Public Property Get ControlKey() As Boolean

    ControlKey = (mModifier And MOD_CONTROL)
    
End Property

Public Property Get hWnd() As Long

    hWnd = mHWND
    
End Property

Public Property Let hWnd(ByVal newHwnd As Long)

    If newHwnd <> mHWND Then
        mHWND = newHwnd
    End If
    
End Property

Public Property Let Modifier(ByVal newval As Long)

    mModifier = newval
    
End Property

Public Sub ReadFromAtom(ByVal hAtom As Long)

Dim sAtom As String
Dim lRet As Long

sAtom = String$(255, 0)

lRet = GlobalGetAtomName(hAtom, sAtom, Len(sAtom))
If Err.LastDllError > 0 Then
    ReportError Err.LastDllError, "ApiHotkey:ReadFromAtom", GetLastSystemError
    Exit Sub
End If
If lRet > 0 Then
    sAtom = Left$(sAtom, lRet)
End If

If InStr(sAtom, "WIN+") Then
    Me.Winkey = True
End If
If InStr(sAtom, "SHIFT+") Then
    Me.ShiftKey = True
End If
If InStr(sAtom, "CONTROL+") Then
    Me.ControlKey = True
End If
If InStr(sAtom, "ALT+") Then
    Me.AltKey = True
End If

If IsNumeric("0" & Right$(sAtom, 3)) Then
    Me.VKey = Val("0" & Right$(sAtom, 3))
End If

End Sub

Public Sub Register()

    If mhAtom <> 0 Then
        GlobalDeleteAtom mhAtom
    End If
    mhAtom = GlobalAddAtom(UniqueAtomName())
    
    Call RegisterHotKey(mHWND, mhAtom, mModifier, mvKey)
    If Err.LastDllError <> 0 Then
        ReportError Err.LastDllError, "ApiHotkey:Register", GetLastSystemError
    End If
    
End Sub

Public Property Let ShiftKey(ByVal NewValue As Boolean)

If NewValue Then
    mModifier = mModifier Or MOD_SHIFT
Else
    mModifier = mModifier Xor MOD_SHIFT
End If

End Property

Public Property Get ShiftKey() As Boolean

    ShiftKey = (mModifier And MOD_SHIFT)
    
End Property


'\\ --[UniqueAtomName]-------------------------------------------------
'\\ Returns a string which uniquely identifies this hotkey combination
'\\ for use in the .id member when regitsering a new hotkey
'\\ -------------------------------------------------------------------
Private Function UniqueAtomName() As String

Dim sAtom As String

If (mModifier And MOD_WIN) Then
    sAtom = sAtom & "WIN+"
End If

If (mModifier And MOD_SHIFT) Then
    sAtom = sAtom & "SHIFT+"
End If

If (mModifier And MOD_CONTROL) Then
    sAtom = sAtom & "CONTROL+"
End If

If (mModifier And MOD_ALT) Then
    sAtom = sAtom & "ALT+"
End If

sAtom = sAtom & Format$(VKey, "000")

End Function

Public Sub Unregister()

If mhAtom <> 0 Then
    Call UnregisterHotKey(mHWND, mhAtom)
    GlobalDeleteAtom mhAtom
End If

End Sub

Public Property Let VKey(ByVal NewValue As Long)

    If NewValue <> mvKey Then
        mvKey = NewValue
    End If
    
End Property

Public Property Get VKey() As Long

    VKey = mvKey
    
End Property

Public Property Let Winkey(ByVal NewValue As Boolean)

If NewValue Then
    mModifier = mModifier Or MOD_WIN
Else
    mModifier = mModifier Xor MOD_WIN
End If

End Property

Public Property Get Winkey() As Boolean

    Winkey = (mModifier And MOD_WIN)
    
End Property


